\ Unicode Word Set
\ Tom Dixon
\ 8/15/2008

\ ==========
\ *! unicode
\ *T Unicode String Library
\ =========

\ *P This provides basic words for working with Unicode strings.
\ ** These Unicode strings are appended with a 16 bit null
\ ** character. This is because of the various abominations in
\ ** the Microsoft documentation as to whether this is needed
\ ** or not.

: UniPlace ( addr len destaddr -- )
\ *G Store a unicode string to an address
   2dup ! 4 + 2dup + 0 swap w! swap cmove ;

: UniAppend ( addr len destaddr -- )
\ *G Append a string to the end of an address
   2dup @ + >r dup >r dup @ + 4 + 2dup + 0 swap ! swap cmove r> r> swap ! ;

Synonym +UniPlace UniAppend
\ *G Same as UniAppend

: UniCount ( addr -- addr len )
\ *G Fetch a unicode string from an address (stored with uniplace)
   dup 4 + swap @ ;

: ZUniCount ( addr -- addr len )
\ *G Fetch a null-terminated unicode string from an address (null is 16-bit)
   dup 0 begin over w@ while 2 2 d+ repeat nip ;

: UniType ( addr len -- )
\ *G Type a unicode string to the console
   2/ 0 ?do dup i 2* + c@ emit loop drop ;

: (U") r> UniCount 2dup + 2 + aligned >r ;

: Ustr, ( addr n -- )
\ *G Add a unicode string to the dictionary at HERE.
   HERE over 6 + allot uniplace ALIGN ;

: Asc>Uni ( str len -- str len )
\ *G Convert an ASCII string to Unicode. You *\b{must} free the
\ ** string with *\fo{FREE} when it is no longer needed.
   dup 2* dup allocate
   err_BadAlloc ?throw
\ abort" Unable to Allocate Unicode String!"
   dup >r 2swap swap MB_PRECOMPOSED 0 MB>WC r> swap 2* ;

: Uni>Asc ( str len -- str len )
\ *G Convert a Unicode string to ASCII. You *\b{must} free the
\ ** string with *\fo{FREE} when it is no longer needed.
   0 0 2over 0 here 2swap swap 0 0 WC>MB 2/ >r
   0 0 2swap r@ dup Allocate
   err_BadAlloc ?throw
\   abort" Unable to Allocate String!"
   dup >r 2swap swap 0 0 WC>MB drop r> r> ;

: >Unicode ( str len -- str len )
\ *G Convert an ASCII string to Unicode. The returned string is
\ ** in *\fo{PAD}.
   asc>uni 2dup pad dup >r uniplace drop free drop r> unicount ;

: >ascii ( str len -- str len )
\ *G Convert a Unicode string to ASCII at *\fo{PAD}.
   uni>asc 2dup pad dup >r place drop free drop r> count ;
   
: u16>ascii >ascii ;

: U" ( ... " -- str len )
\ *G Unicode string - should behave the same way as s"
   STATE @ IF POSTPONE (U") [char] " PARSE
     asc>uni 2dup ustr, drop free drop EXIT THEN
   [char] " PARSE >unicode ; IMMEDIATE


\ *S BSTR words
\ *P Some APIs require more specific conditions to their unicode strings.
\ ** (ie: distributed and network apis)
\ ** bstr has more constraints applied to it.  These words are to convert
\ ** to bstrs and back again.

: Asc>bstr ( str len -- bstr )
\ *G Convert ascii string to unicode bstr.  bstr must be freed later with 'bstrfree'.
   dup dup 0 fSysAllocStringLen dup >r
   2swap swap
   MB_PRECOMPOSED
   CP_ACP
   MB>WC drop  r> ;

: bstrFree ( bstr -- )
\ *G Free a BSTR.
   fSysFreeString ;

: bstrlen ( bstr -- len )
\ *G Returns the length of the bstr.  From this the bstr can be used with all the
\ ** other unicode functions.
   cell- @ ;


\ ======
\ *> ###
\ ======
